unit cdemo_rf;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  Tfrm_demo_rf = class(TForm)
    List1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button4: TButton;
    Button5: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    function convertChararrToHexstr(chararr:array of char;cnt: Integer):string ;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_demo_rf:Tfrm_demo_rf;
  hexkey2:pchar;
  tagtype :Longint;
  snr:longword;
  data32:pchar;
  databuff32,datadevstr:pchar;
  rvalue:Longint;
  wvalue:Longint;
  cardmode:Integer;
  loadmode:Integer;
  sector:Integer;
  address:Integer;
  size:Byte;
  tempint:longword;
  st:smallint;
  readdata:array[0..32]of char;
  curCardType:Integer;

  hdevs:Array [0..9] of integer=(-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);    //in case of less than 10 reader
implementation

uses drv_unit;

{$R *.DFM}
function Tfrm_demo_rf.convertChararrToHexstr(chararr:array of char;cnt: Integer):string;
var
 str:string;
 tempstr:string;
 I:integer;
begin

for I := 0 to cnt-1 do
begin
tempstr:=inttohex(integer(chararr[i]),2);
str:=str+tempstr;
end;

Result:=str;
end;

procedure Tfrm_demo_rf.Button1Click(Sender: TObject);
var
 tmpdev:integer;
 i:integer;

begin
if CheckBox1.Checked=true then begin

//in case of more then one reader,repeat call fw_init can get handle of each devicce
 i:=0;
 repeat
 tmpdev:=fw_init(100,0);

 if tmpdev>0 then begin
 hdevs[i]:=tmpdev;
 i:=i+1;
 end;

 until (tmpdev<0);

 icdev:=hdevs[0];

end

else begin
icdev:=fw_init(0,115200); //COM1£¬baut rate: 115200
end;

  If icdev < 0 Then begin
      List1.items.Add('Call fw_init() function error!');
      exit;
 end
   else  begin
   List1.Items.add('Call fw_init() function success!');
   end;
  end;

procedure Tfrm_demo_rf.Button2Click(Sender: TObject);
var   keyarr : Array [0..6] of char  ;
begin
 keyarr[0]:=Chr($ff);
 keyarr[1]:=Chr($ff);
 keyarr[2]:=Chr($ff);
 keyarr[3]:=Chr($ff);
 keyarr[4]:=Chr($ff);
 keyarr[5]:=Chr($ff);

 //hexkey := 'a0a1a2a3a4a5';
 st := fw_load_key(icdev, 0, 1,@keyarr);
 If st <> 0 Then begin
      List1.items.add('Call fw_Load_key() function error!');
      exit;
 end;

 List1.items.add('Call fw_Load_key() function success!');

 end;

procedure Tfrm_demo_rf.Button3Click(Sender: TObject);
 var
 sendbuf: Array[0..16] of char;
 str:string;
 value:LongWord;
 cardbuf:Array[0..8] of char; // card serial number

begin
 st := fw_beep(icdev, 1);
 If st <> 0 Then begin
      List1.items.Add('Call fw_beep() function error');
      Exit;
 End;
 List1.items.add('Call fw_beep() success');
 application.ProcessMessages;

case curCardType of

0:
  begin

 cardmode := 1;//repeat find card when mode value 1, when value 0, the card must take away before redo
 address  := 4 ;
 sector   := 1 ;


 //st := fw_card(icdev,cardmode,tempint);   //Not recommand use this function,sometimes get netative
 st:=fw_card_hex(icdev,cardmode,cardbuf);//return  card number as HEX-string

 If st <> 0 Then begin
      List1.items.add('Call fw_card() function error');
      Exit;
End;
 List1.items.add('Call fw_card() function success');
 //List1.items.add('Card serial number: '+inttostr(tempint));
 List1.Items.Add('Card serial number: '+cardbuf);

 st := fw_authentication(icdev, 0, sector);
 If st <> 0 Then begin
      List1.Items.Add('Call fw_authentication() function error!');
      Exit;
 End;
 List1.Items.Add('Call fw_authentication() function success!');


 sendbuf[0]:=Chr($00);
 sendbuf[1]:=Chr($11);
 sendbuf[2]:=Chr($22);
 sendbuf[3]:=Chr($33);
 sendbuf[4]:=Chr($44);
 sendbuf[5]:=Chr($55);
 sendbuf[6]:=Chr($66);
 sendbuf[7]:=Chr($77);
 sendbuf[8]:=Chr($88);
 sendbuf[9]:=Chr($99);
 sendbuf[10]:=chr($AA);
 sendbuf[11]:=Chr($BB);
 sendbuf[12]:=Chr($CC);
 sendbuf[13]:=Chr($DD);
 sendbuf[14]:=Chr($EE);
 sendbuf[15]:=Chr($FF);

 st := fw_write(icdev, address, @sendbuf);   //the third block of each sector is key block
                                             //do not write this block when testing
 If st <> 0 Then begin
     List1.Items.add('Call fw_write function error');
     Exit;
 End;
 List1.Items.add('Call fw_write function success');
 //getmem(datadevStr,33);
 st := fw_read(icdev, address,readdata);
 If st <> 0 Then begin
     List1.Items.add('Call fw_read function error');
     //freemem(datadevstr);
     Exit;
 End;
 List1.Items.add('Call fw_read function success');
 str:=convertChararrToHexstr(readdata,16);
 List1.items.add('Data: '+str);
// freemem(datadevstr);

st:=fw_initval(icdev,address,1000);
if st<>0 Then begin
  List1.Items.Add('Call fw_initval function error');
  Exit;
  End;
List1.Items.Add('Call fw_initval function success' );

st:=fw_readval(icdev,address,@value);
if st<>0 then begin
  List1.Items.Add('Call fw_readval function error') ;
  Exit;
  End;

  List1.Items.Add('Call fw_readval function success');
  List1.Items.Add('value of this block: '+inttostr(value)) ;

 st:=fw_decrement(icdev,address,10);
 st:=fw_transfer(icdev,address);  //this function should be called after decrement,otherwise the changing
                                  //will be invalided
 if st<>0 Then begin
    List1.Items.Add('Call fw_decrement function error');
    List1.Items.Add('Call fw_transfer function error');
    Exit;
 End;

 List1.Items.Add('Call fw_decrement function success');
 List1.Items.Add('Call fw_transfer function success');

 st := fw_halt(icdev);
 If st <> 0 Then begin
      List1.Items.add('Call fw_halt() function error');
      Exit;
 End;
 List1.Items.add('Call fw_halt() function success');
 List1.Items.add('Read/Write test passed!');
 End;   //case 0

1:
  begin

 cardmode := 1;//repeat find card when mode value 1, when value 0, the card must take away before redo
 address  := 128+(34-32)*16 ;
 sector   := 34 ;


// st := fw_card(icdev,cardmode,tempint); //Not recommand use this function,sometimes get netative
  st:=fw_card_hex(icdev,cardmode,cardbuf);//return  card number as HEX-string
 If st <> 0 Then begin
      List1.items.add('Call fw_card() function error');
      Exit;
End;


 List1.items.add('Call fw_card() function success');
// List1.items.add('Card serial number:'+inttostr(tempint));
 List1.items.add('Card serial number: '+cardbuf);

 st := fw_authentication(icdev, 0, sector);
 If st <> 0 Then begin
      List1.Items.Add('Call fw_authentication() function error!');
      Exit;
 End;
 List1.Items.Add('Call fw_authentication() function success!');


 sendbuf[0]:=Chr($00);
 sendbuf[1]:=Chr($11);
 sendbuf[2]:=Chr($22);
 sendbuf[3]:=Chr($33);
 sendbuf[4]:=Chr($44);
 sendbuf[5]:=Chr($55);
 sendbuf[6]:=Chr($66);
 sendbuf[7]:=Chr($77);
 sendbuf[8]:=Chr($88);
 sendbuf[9]:=Chr($99);
 sendbuf[10]:=chr($AA);
 sendbuf[11]:=Chr($BB);
 sendbuf[12]:=Chr($CC);
 sendbuf[13]:=Chr($DD);
 sendbuf[14]:=Chr($EE);
 sendbuf[15]:=Chr($FF);

 st := fw_write(icdev, address, @sendbuf);
 If st <> 0 Then begin
     List1.Items.add('Call fw_write function error');
     Exit;
 End;
 List1.Items.add('Call fw_write function success');
 //getmem(datadevStr,33);
 st := fw_read(icdev, address,readdata);
 If st <> 0 Then begin
     List1.Items.add('Call fw_read function error');
     //freemem(datadevstr);
     Exit;
 End;
 List1.Items.add('Call fw_read function success ');
 str:=convertChararrToHexstr(readdata,16);
 List1.items.add('Data: '+str);
// freemem(datadevstr);

st:=fw_initval(icdev,address,1000);
if st<>0 Then begin
  List1.Items.Add('Call fw_initval function error');
  Exit;
  End;
List1.Items.Add('Call fw_initval function success' );

st:=fw_readval(icdev,address,@value);
if st<>0 then begin
  List1.Items.Add('Call fw_readval function error') ;
  Exit;
  End;

  List1.Items.Add('Call fw_readval function success');
  List1.Items.Add('value of this block: '+inttostr(value)) ;

 st:=fw_decrement(icdev,address,10);
 st:=fw_transfer(icdev,address);
 if st<>0 Then begin
    List1.Items.Add('Call fw_decrement function error');
    List1.Items.Add('Call fw_transfer function error');
    Exit;
 End;

 List1.Items.Add('Call fw_decrement function success');
 List1.Items.Add('Call fw_transfer function success');




 st := fw_halt(icdev);
 If st <> 0 Then begin
      List1.Items.add('Call fw_halt() function error');
      Exit;
 End;
 List1.Items.add('Call fw_halt() function success');
 List1.Items.add('Read/Write test passed!');
 End;   //case 1
 2:
 begin
 //find card
 st:=fw_request_ultralt(icdev,1);
 if st<>0 then begin
   List1.Items.Add('Call fw_request_ultralt function error');
   Exit;
 End;
   List1.Items.Add('Call fw_request_ultralt function success');

 st:=fw_anticall_ultralt(icdev, tempint);
 if st<>0 then begin
   List1.Items.Add('Call fw_anticall_ultralt function error');
   Exit;
 End;

 List1.Items.Add('Call fw_anticall_ultralt funciton success');
 List1.items.add('Card serial number:'+inttostr(tempint));

 st:=fw_select_ultralt(icdev,tempint);
 if st<>0 then begin
   List1.Items.Add('Call fw_select_ultralt function error');
   Exit;
 End;
 List1.Items.Add('Call fw_select_ultralt function success');


 //write card
 sendbuf[0]:=Chr($11);
 sendbuf[1]:=Chr($22);
 sendbuf[2]:=Chr($33);
 sendbuf[3]:=Chr($44);

 //read block 0 before read card
 st:=fw_read_ultralt(icdev,0,readdata);//read block 0
 if st<>0 then begin
    List1.Items.Add('Read Page 0 error');
    Exit;
 End;

 st:=fw_write_ultralt(icdev,4, @sendbuf); //write block 4
 if st<>0 then begin
   List1.Items.Add('Call function fw_write_ultralt error');
   Exit;
 End;
 List1.Items.Add('Call function fw_write_ultralt success');

 //read card
 st:=fw_read_ultralt(icdev,4,readdata);     //read block 4
 if st<>0 then begin
   List1.Items.Add('Call function fw_read_ultralt error');
   Exit;
 End;
 List1.Items.Add('Call function fw_read_ultralt success');
 str:=convertChararrToHexstr(readdata,8);
 List1.items.add('Data: '+str);

 End;
 else
 End;
 

end;

procedure Tfrm_demo_rf.Button5Click(Sender: TObject);

var
keyarr:Array [0..6] of char;
sendbuf:Array[0..16]of char;


begin


//code under change key of sector 2 form ffffffffffff
//to  112233445566, then change back to ffffffffffff
 cardmode := 1 ;
 sector   := 1 ;

 keyarr[0]:=Chr($ff);
 keyarr[1]:=Chr($ff);
 keyarr[2]:=Chr($ff);
 keyarr[3]:=Chr($ff);
 keyarr[4]:=Chr($ff);
 keyarr[5]:=Chr($ff);

 st := fw_load_key(icdev, 0, 1,@keyarr);
 If st <> 0 Then begin
      List1.items.add('Call fw_Load_key() function error!');
      exit;
 end;
 List1.items.add('Call fw_Load_key() function success!');

 st := fw_card(icdev,cardmode,tempint);
 If st <> 0 Then begin
      List1.items.add('Call fw_card() function error');

      Exit;
 End;
 List1.items.add('Call fw_card() function error');

 st := fw_authentication(icdev, 0, sector);
 If st <> 0 Then begin
      List1.Items.Add('Call fw_authentication() function error!');
      Exit;
 End;
 List1.Items.Add('Call fw_authentication() function success!');

//now change keyA from 112233445566 to FFFFFFFFFFFF
 sendbuf[0]:=Chr($11);
 sendbuf[1]:=Chr($22);
 sendbuf[2]:=Chr($33);
 sendbuf[3]:=Chr($44);
 sendbuf[4]:=Chr($55);
 sendbuf[5]:=Chr($66);
 sendbuf[6]:=Chr($FF);
 sendbuf[7]:=Chr($07);
 sendbuf[8]:=Chr($80);
 sendbuf[9]:=Chr($69);
 sendbuf[10]:=chr($FF);
 sendbuf[11]:=Chr($FF);
 sendbuf[12]:=Chr($FF);
 sendbuf[13]:=Chr($FF);
 sendbuf[14]:=Chr($FF);
 sendbuf[15]:=Chr($FF);

  st := fw_write(icdev,1*4+3,@sendbuf);
 If st <> 0 Then begin
      List1.Items.Add('Call fw_write() function error!');
      Exit;
 End;
    List1.Items.Add('KeyA be changed to 112233445566');
 //now the keyA is 112233445566



 //reload key
 keyarr[0]:=Chr($11);
 keyarr[1]:=Chr($22);
 keyarr[2]:=Chr($33);
 keyarr[3]:=Chr($44);
 keyarr[4]:=Chr($55);
 keyarr[5]:=Chr($66);

 st := fw_load_key(icdev, 0, 1,@keyarr);
 If st <> 0 Then begin
      List1.items.add('Call fw_Load_key() function error!');
      exit;
 end;
 List1.items.add('Call fw_Load_key() function success!');

  st := fw_card(icdev,cardmode,tempint);
 If st <> 0 Then begin
      List1.items.add('Call fw_card() function error');

      Exit;
 End;
 List1.items.add('Call fw_card() function success');

 st := fw_authentication(icdev, 0, sector);
 If st <> 0 Then begin
      List1.Items.Add('Call fw_authentication() function error!');
      Exit;
 End;
 List1.Items.Add('Call fw_authentication() function success!');

//now KeyA change back  ffffffffffff, keyB change back to ffffffffffff
 sendbuf[0]:=Chr($FF);
 sendbuf[1]:=Chr($FF);
 sendbuf[2]:=Chr($FF);
 sendbuf[3]:=Chr($FF);
 sendbuf[4]:=Chr($FF);
 sendbuf[5]:=Chr($FF);
 sendbuf[6]:=Chr($FF);
 sendbuf[7]:=Chr($07);
 sendbuf[8]:=Chr($80);
 sendbuf[9]:=Chr($69);
 sendbuf[10]:=chr($FF);
 sendbuf[11]:=Chr($FF);
 sendbuf[12]:=Chr($FF);
 sendbuf[13]:=Chr($FF);
 sendbuf[14]:=Chr($FF);
 sendbuf[15]:=Chr($FF);
  st := fw_write(icdev,1*4+3,@sendbuf);
 If st <> 0 Then begin
      List1.Items.Add('Call fw_write() function error!');
      Exit;
 End;

 // now the keyA is ffffffffffff
   List1.Items.Add('keyA be changed back to ffffffffffff');
   List1.Items.Add('update key operation Over!');
end;

procedure Tfrm_demo_rf.Button4Click(Sender: TObject);
begin
quit();
close
end;


procedure Tfrm_demo_rf.FormCreate(Sender: TObject);
begin
ComboBox1.ItemIndex:=0 ;

end;

procedure Tfrm_demo_rf.ComboBox1Change(Sender: TObject);
begin
curCardType:=ComboBox1.ItemIndex;
if curCardType=2 Then
Button5.Enabled:=false
else
Button5.Enabled:=true;


end;

end.
